Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'GetTickCount declare
Private Declare Function GetTickCount Lib "kernel32" () As Long
'Declares for closing the form without waiting
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const WM_CLOSE = &H10
'Host expire threshold constant
Private Const HOST_EXPIRE_THRESHHOLD As Long = 2000
Private Type HostFound
AppDesc As DPN_APPLICATION_DESC
AddressHost As String
AddressDevice As String
TimeLastFound As Long
End Type
Private Enum WizPanes
PickProtocol
CreateJoinGame
CreateNewGame
WaitForLobby
End Enum
Private Enum SearchingButton
StartSearch
StopSearch
End Enum
'Internal DirectX variables
Private moDPP As DirectPlay8Peer
Private moDPC As DirectPlay8Client
Private moDPA As DirectPlay8Address
Private moDX As DirectX8
Private moCallback As DirectPlay8Event
Private moDPLA As DirectPlay8LobbiedApplication
'App specific vars
Private msGuid As String
Private sUser As String
Private mlSearch As SearchingButton
Private sGameName As String
Private mlMax As Long
Private mlNumPlayers As Long
Private mfComplete As Boolean
Private mfHost As Boolean
Private mlEnumAsync As Long
Private mfGotEvent As Boolean
Private mfDoneWiz As Boolean
Private mlLobbyClientID As Long
Private mfCanUnload As Boolean
'We need to keep track of the hosts we get
Private moHosts() As HostFound
Private mlHostCount As Long
'Declaration for our API
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private mfDoneEnum As Boolean
Private mfConnectComplete As Boolean
'We need to implement the Event model for DirectPlay so we can receive callbacks
Implements DirectPlay8Event
Implements DirectPlay8LobbyEvent
Private Function StartWizard(oDX As DirectX8, sGuid As String, ByVal lMaxPlayers As Long, Optional oCallback As DirectPlay8Event = Nothing, Optional ByVal fAllowMigrateHost As Boolean = True) As Boolean
Dim lCount As Long, lIndex As Long
Dim dpn As DPN_SERVICE_PROVIDER_INFO
'Now we can start our connection
mfCanUnload = False
mlSearch = StartSearch
mlHostCount = -1
'First we need to keep track of our Peer Object, and app guid
Public Function StartClientConnectWizard(oDX As DirectX8, oDPC As DirectPlay8Client, sGuid As String, ByVal lMaxPlayers As Long, Optional oCallback As DirectPlay8Event = Nothing, Optional ByVal fAllowMigrateHost As Boolean = True) As Boolean
Public Function StartConnectWizard(oDX As DirectX8, oDPP As DirectPlay8Peer, sGuid As String, ByVal lMaxPlayers As Long, Optional oCallback As DirectPlay8Event = Nothing, Optional ByVal fAllowMigrateHost As Boolean = True) As Boolean
MsgBox "You must enter a session name to create a session.", vbOKOnly Or vbInformation, "No name."
Exit Sub 'No need to continue
End If
If Val(txtUsers.Text) < 1 Then
MsgBox "You must enter a number of max players.", vbOKOnly Or vbInformation, "No max players."
Exit Sub 'No need to continue
End If
If Val(txtUsers.Text) > mlMax Then
MsgBox "The number of maximum players you specified exceeds the number of maximum players allowed in this session." & vbCrLf & "Please lower the number of your maximum players.", vbOKOnly Or vbInformation, "Too many players."
'We will handle all of the msgs here, and report them all back to the callback sub
'in case the caller cares what's going on
Private Sub DirectPlay8Event_AddRemovePlayerGroup(ByVal lMsgID As Long, ByVal lPlayerID As Long, ByVal lGroupID As Long, fRejectMsg As Boolean)
'VB requires that we must implement *every* member of this interface
If (Not moCallback Is Nothing) Then moCallback.AddRemovePlayerGroup lMsgID, lPlayerID, lGroupID, fRejectMsg
End Sub
Private Sub DirectPlay8Event_AppDesc(fRejectMsg As Boolean)
'VB requires that we must implement *every* member of this interface
If (Not moCallback Is Nothing) Then moCallback.AppDesc fRejectMsg
End Sub
Private Sub DirectPlay8Event_AsyncOpComplete(dpnotify As DxVBLibA.DPNMSG_ASYNC_OP_COMPLETE, fRejectMsg As Boolean)
If dpnotify.AsyncOpHandle = mlEnumAsync Then mlEnumAsync = 0
'VB requires that we must implement *every* member of this interface
If (Not moCallback Is Nothing) Then moCallback.AsyncOpComplete dpnotify, fRejectMsg
End Sub
Private Sub DirectPlay8Event_ConnectComplete(dpnotify As DxVBLibA.DPNMSG_CONNECT_COMPLETE, fRejectMsg As Boolean)
mfGotEvent = True
If dpnotify.hResultCode = DPNERR_SESSIONFULL Then 'Already too many people joined up
MsgBox "The maximum number of people allowed in this session have already joined. Please choose a different session or create your own.", vbOKOnly Or vbInformation, "Full"
ShowPane CreateJoinGame
Else
'We got our connect complete event
mfConnectComplete = True
'VB requires that we must implement *every* member of this interface
If (Not moCallback Is Nothing) Then moCallback.ConnectComplete dpnotify, fRejectMsg
End If
End Sub
Private Sub DirectPlay8Event_CreateGroup(ByVal lGroupID As Long, ByVal lOwnerID As Long, fRejectMsg As Boolean)
'VB requires that we must implement *every* member of this interface
If (Not moCallback Is Nothing) Then moCallback.CreateGroup lGroupID, lOwnerID, fRejectMsg
End Sub
Private Sub DirectPlay8Event_CreatePlayer(ByVal lPlayerID As Long, fRejectMsg As Boolean)
'VB requires that we must implement *every* member of this interface
If (Not moCallback Is Nothing) Then moCallback.CreatePlayer lPlayerID, fRejectMsg
End Sub
Private Sub DirectPlay8Event_DestroyGroup(ByVal lGroupID As Long, ByVal lReason As Long, fRejectMsg As Boolean)
'VB requires that we must implement *every* member of this interface
If (Not moCallback Is Nothing) Then moCallback.DestroyGroup lGroupID, lReason, fRejectMsg
End Sub
Private Sub DirectPlay8Event_DestroyPlayer(ByVal lPlayerID As Long, ByVal lReason As Long, fRejectMsg As Boolean)
'VB requires that we must implement *every* member of this interface
If (Not moCallback Is Nothing) Then moCallback.DestroyPlayer lPlayerID, lReason, fRejectMsg
End Sub
Private Sub DirectPlay8Event_EnumHostsQuery(dpnotify As DxVBLibA.DPNMSG_ENUM_HOSTS_QUERY, fRejectMsg As Boolean)
'VB requires that we must implement *every* member of this interface
If (Not moCallback Is Nothing) Then moCallback.EnumHostsQuery dpnotify, fRejectMsg
End Sub
Private Sub DirectPlay8Event_EnumHostsResponse(dpnotify As DxVBLibA.DPNMSG_ENUM_HOSTS_RESPONSE, fRejectMsg As Boolean)
'Go ahead and add this to our list
AddHostsToListBox dpnotify
'VB requires that we must implement *every* member of this interface
If (Not moCallback Is Nothing) Then moCallback.EnumHostsResponse dpnotify, fRejectMsg
End Sub
Private Sub DirectPlay8Event_HostMigrate(ByVal lNewHostID As Long, fRejectMsg As Boolean)
'VB requires that we must implement *every* member of this interface
If (Not moCallback Is Nothing) Then moCallback.HostMigrate lNewHostID, fRejectMsg
End Sub
Private Sub DirectPlay8Event_IndicateConnect(dpnotify As DxVBLibA.DPNMSG_INDICATE_CONNECT, fRejectMsg As Boolean)
'VB requires that we must implement *every* member of this interface
If (Not moCallback Is Nothing) Then moCallback.IndicateConnect dpnotify, fRejectMsg
End Sub
Private Sub DirectPlay8Event_IndicatedConnectAborted(fRejectMsg As Boolean)
'VB requires that we must implement *every* member of this interface
If (Not moCallback Is Nothing) Then moCallback.IndicatedConnectAborted fRejectMsg
End Sub
Private Sub DirectPlay8Event_InfoNotify(ByVal lMsgID As Long, ByVal lNotifyID As Long, fRejectMsg As Boolean)
'VB requires that we must implement *every* member of this interface
If (Not moCallback Is Nothing) Then moCallback.InfoNotify lMsgID, lNotifyID, fRejectMsg
End Sub
Private Sub DirectPlay8Event_Receive(dpnotify As DxVBLibA.DPNMSG_RECEIVE, fRejectMsg As Boolean)
'VB requires that we must implement *every* member of this interface
If (Not moCallback Is Nothing) Then moCallback.Receive dpnotify, fRejectMsg
End Sub
Private Sub DirectPlay8Event_SendComplete(dpnotify As DxVBLibA.DPNMSG_SEND_COMPLETE, fRejectMsg As Boolean)
'VB requires that we must implement *every* member of this interface
If (Not moCallback Is Nothing) Then moCallback.SendComplete dpnotify, fRejectMsg
End Sub
Private Sub DirectPlay8Event_TerminateSession(dpnotify As DxVBLibA.DPNMSG_TERMINATE_SESSION, fRejectMsg As Boolean)
'VB requires that we must implement *every* member of this interface
If (Not moCallback Is Nothing) Then moCallback.TerminateSession dpnotify, fRejectMsg
End Sub
Private Sub DirectPlay8LobbyEvent_Connect(dlNotify As DxVBLibA.DPL_MESSAGE_CONNECT, fRejectMsg As Boolean)
Dim oDev As DirectPlay8Address, oHost As DirectPlay8Address